home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / ZIP.PAS < prev   
Pascal/Delphi Source File  |  1994-05-03  |  3KB  |  107 lines
  1. {$S-,R-,V-,I-,B-,F-}
  2. {$M 20000,0,50000}
  3.  
  4. program ZIP;
  5.  
  6. uses  Dos, PbMISC, PbDATA, PbPARMS, PbEXEC;
  7.  
  8. {
  9. Description : Convenience shell for PKZIP for quick packing and cleanup.
  10.  
  11. Author      : Howard Richoux
  12. Date        : 12/18/93
  13. Last revised:
  14. Application : IBM PC and compatibles, done in Turbo Pascal 7.0
  15. Status      : Placed in the Public Domain by HNR Software 1/29/94
  16. Published in: none
  17.  
  18. Config Parameters      meaning                           default
  19.        CLEANUP         Cleanup temp and bak files        'NO'
  20.        PURGEZIP        Purge the ZIP on \ZIP first       'YES'
  21.        ZIPDIR          Place to store the ZIP files      'c:\zip\'
  22.        ZIPOPT          update/recurse dirs/pathname      '-urpo'
  23. }
  24.  
  25. type  PathName = string;
  26.  
  27. var  s         : string;
  28.  
  29. var  StartDir    : PathName;      {Drive:directory to be archived}
  30.      ZIPDIR      : PathName;      {Place for PKZIP to put packed file}
  31.      ZIPOptions  : string;        {PKZIP command option flags }
  32.      CleanUpFlag : boolean;       {Do/Don't erase junk files }
  33.      PurgeZIP    : boolean;       {purge ZIP file before writing to it}
  34.  
  35.  
  36. Procedure ZipIt(WorkDir : PathName);
  37. var s,dirtag,zname,opt : string;
  38.     i,err : integer;
  39.     begin
  40.     DirTag := AddBackSlash(WorkDir);
  41.     i := 1;
  42.     while i > 0 do
  43.         begin
  44.         i := POS('\',DirTag);
  45.         if (i > 0) and (i < length(dirtag)) then Delete(Dirtag,1,i)
  46.         else i := 0;
  47.         end;
  48.     if length(dirtag) > 0 then
  49.         begin
  50.         DirTag := DeleteBackSlash(DirTag);
  51.         zname :=  AddBackSlash(ZIPDIR)+dirtag;
  52.         opt := ZIPOptions + ' -x'+dirtag+'.zip';
  53.         if purgezip then erasefile(zname+'.zip');
  54.         writeln('options [',opt,']');
  55.         if ZIPFile(opt,zname,'*.*',false) then
  56.              begin
  57.              s := 'PKUNZIP -t ' + AddBackSlash(ZIPDIR) + DirTag;
  58.              Err := ExecuteCommand(s);
  59.              if Err > 0 then writeln('PKUNZIP start failed ',Err)
  60.              end
  61.         else DisplayZIPError;
  62.  
  63.         s := 'DDIR ' + DeleteBackSlash(ZIPDIR);
  64.         writeln(s);
  65.         Err := ExecuteCommand(s);
  66.         if Err > 0 then writeln('DDIR start failed ',Err);
  67.         end;
  68.     end;
  69.  
  70.  
  71.  
  72. Procedure Initialize;
  73.     begin
  74.  
  75.     {Set default search parameters}
  76.     GetDir(0,StartDir);
  77.     writeln('Default directory: ',Startdir);
  78.  
  79.     AddParm(1,'CLEANUP','NO');
  80.     AddParm(1,'PURGEZIP','YES');
  81.     AddParm(1,'ZIPDIR','c:\zip\');
  82.     AddParm(1,'ZIPOPT','-urpo ');
  83.  
  84.     StandardpVarsInit;
  85.  
  86.     ZIPDIR      := GetParmStr('ZIPDIR');
  87.     ZIPOptions  := GetParmStr('ZIPOPT');
  88.     CleanUpFlag := CheckOK('CLEANUP');
  89.     PurgeZIP    := CheckOK('PURGEZIP');
  90.     writeln('        Save Area: ',ZIPDIR);
  91.     end;
  92.  
  93.  
  94.     begin   {MAIN}
  95.     pProgID := 'ZIP 1.20';
  96.     Initialize;
  97.     if CleanUpFlag then
  98.          begin
  99.          if GetParmStr('CLEANUP1') <> '' then
  100.               ParmCleanUp(StartDir)
  101.          else DefaultCleanUp(StartDir);
  102.          ShowEraseStats;
  103.          writeln('');
  104.          end;
  105.     ZipIt(StartDir);
  106.     end.
  107.